home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / INREAL.INC < prev    next >
Text File  |  1991-09-07  |  5KB  |  147 lines
  1. function INREAL (var Filin: text; var Realvar: vartype; var Comment: text80;
  2.   var Cmmd: cmmdtype; var Parm: parmtype; var Line_num: integer;
  3.   Interactive: boolean): integer;
  4.  
  5. { Read in a line from a file or standard Input, and decode the
  6.   numeric input in a reasonable way (similar to Fortran). Allow a trailing
  7.   decimal point, commas between entries, and any number of spaces or tabs.
  8.   If an asterisk is encountered on the line, everything after it is taken
  9.   to be a comment. If the line begins with an asterisk, then the entire
  10.   line is taken to be a comment and another line is read immediately
  11.   WITHOUT EVER RETURNING THE FIRST COMMENT TO THE CALLING PROGRAM.
  12.   To read from standard Input, instead of from a file,
  13.   set the Interactive flag to TRUE (otherwise FALSE).  If not Interactive,
  14.   then INREAL never returns 0 variables; it always reads another line.
  15.   If Interactive, then 0 variables is a legal return.  A 0 return means
  16.   end of file.
  17. }
  18. var Line: text255;                { line of input }
  19.     i: integer;                   { points to character in Line }
  20.     j: integer;                   { general index }
  21.     Num: integer;                 { number of numeric entry }
  22.     Firstdig: integer;            { pointer to first digit of entry }
  23.     Lennum: integer;              { length of total numeric entry }
  24.     Ndeci: integer;               { # decimal pts. in entry }
  25.     Retcode: integer;             { return code from function }
  26.     Lastcomma: boolean;           { keep track of whether last significant
  27.                                     character was a comma }
  28.     Success: boolean;
  29.  
  30. begin
  31.   Success := TRUE;
  32.   Lastcomma := TRUE;
  33.   Comment := '';
  34.   Num := 0;
  35.   Line := '*';
  36.   Cmmd := CMD_NONE;
  37.   Parm := PRM_NONE;
  38.  
  39.   { Read until line is not a comment }
  40.   while (Line[1] = '*') and (Success) do begin
  41.     if (Interactive) then begin
  42.       readln (Line);
  43.       if (length(Line) = 0) then
  44.         Line[1] := ' ';
  45.     end else begin
  46.       if (eof (Filin)) then
  47.         Success := false
  48.       else
  49.         readln (Filin, Line);
  50.     end;
  51.     { KVC 09/07/91 Advance the line number }
  52.     if (Line_num >= 0) then
  53.       Line_num := Line_num + 1;
  54.   end;
  55.   Line[length(Line)+1] := ' ';
  56.   i := 1;
  57.  
  58.   { KVC 09/02/91 Check for a symbolic command }
  59.   if (Success) then begin
  60.     chkcmmd (Cmmd, Parm, i, Line);
  61.     if (Cmmd = CMD_INVALID) then
  62.       success := FALSE
  63.     else if (Cmmd = CMD_TITLE) then begin
  64.       { Title is a special case - return plot title in comment }
  65.       Comment := copy (Line, i, 255);
  66.       { Stop the rest of the line from being parsed }
  67.       i := length(Line) + 1;
  68.     end;
  69.   end;
  70.  
  71.   while (i <= length(Line)) and (Num < MAXVAR) and (Num >= 0) and (Success)
  72.       do begin
  73.     if (Line[i] = ' ') or (Line[i] = ^I) or (Line[i] = ',') or
  74.        (Line[i] = ^M) then begin
  75.       if (Lastcomma) and (Line[i] = ',') then begin
  76.         { Two commas in a row: a 0 input }
  77.         Num := Num + 1;
  78.         Realvar[Num] := 0;
  79.       end
  80.       else if (Line[i] = ',') then
  81.         Lastcomma := TRUE;
  82.       i := i + 1;
  83.     end
  84.     else if ((Line[i] <= '9') and (Line[i] >= '0')) or (Line[i] = '.') or
  85.             (Line[i] = '-') then begin
  86.       Lastcomma := FALSE;
  87.       Num := Num + 1;
  88.       Firstdig := i;
  89.       Lennum := 1;
  90.       i := i + 1;
  91.       while (i <= length(Line)) and (((Line[i] <= '9') and (Line[i] >= '0'))
  92.             or (Line[i] = '.') or (Line[i] = 'E') or (Line[i] = 'e')
  93.             or (Line[i] = '-') or (Line[i] = '+')) do begin
  94.         Lennum := Lennum + 1;
  95.         i := i + 1;
  96.       end;
  97.       if Line[i] = '.' then
  98.         { Remove trailing decimal point }
  99.         Lennum := Lennum - 1;
  100.       if (Lennum < 1) then
  101.         { Flag bad entry }
  102.         Num := -i
  103.       else begin
  104.  
  105.         { silly code to convert to 4.0 so -.1 and 1. work }
  106.         if (lennum > 0) and (line[firstdig + lennum - 1] = '.') then
  107.           lennum := lennum - 1;
  108.         if line[Firstdig] = '.' then
  109.           val ('0'+copy (Line, Firstdig, Lennum), Realvar[Num], Retcode)
  110.         else if (line[firstdig] = '-') and (line[firstdig + 1] = '.') then
  111.           val ('-0' + copy (Line, Firstdig + 1, Lennum - 1),
  112.               Realvar[Num], Retcode)
  113.         else
  114.           val (copy (Line, Firstdig, Lennum), Realvar[Num], Retcode);
  115.         if (Retcode > 0) then begin
  116.           Num := -(Firstdig + Retcode - 1);
  117.         end;
  118.       end;
  119.     end else if (Line[i] = '*') then begin
  120.       Comment := copy(Line, i+1, length(Line)-i);
  121.       i := length(Line) + 1;    { just to stop the while loop }
  122.     end else
  123.       Num := -i;  { flag bad character }
  124.   end; {while}
  125.  
  126.   if (not Success) then
  127.     Num := 0;
  128.  
  129.   if (Num < 0) then begin
  130.     if (Line_num > 0) then
  131.       writeln ('Bad input found in line ', Line_num,':')
  132.     else
  133.       writeln ('Bad input:');
  134.     writeln (Line);
  135.     for j := 1 to (-Num-1) do
  136.       write ('-');
  137.     write ('^');
  138.     for j := (-Num+1) to length(Line) do
  139.       write ('-');
  140.     writeln;
  141.     writeln ('Numeric input was expected.');
  142.     writeln ('(The carat (^) points to the bad character.)');
  143.   end; { if Num }
  144.  
  145.   Inreal := Num;
  146. end; { function Inreal }
  147.